home *** CD-ROM | disk | FTP | other *** search
Text File | 1995-02-07 | 3.1 KB | 107 lines | [TEXT/MPS ] |
- (*
- CTBNewFileTransfer [tool] -- Make a new file transfer tool. If one is open, dispose of it. The tool
- parameter is the name of the tool to use initially.
-
- To compile and link this file using Macintosh Programmer's Workshop,
-
- pascal -w CTBNewFileTransfer.p
- link -m ENTRYPOINT -o HyperCommands -rt XCMD=2757 -sn Main=CTBNewFileTransfer ∂
- CTBNewFileTransfer.p.o "{MPW}"Libraries:interface.o "{MPW}"Libraries:Libraries:HyperXLib.o
-
- © Copyright 1990 by Apple Computer, Inc.
-
- Initial coding 2/90 by Harry R. Chesley.
- *)
-
- {$R-}
-
- {$S CTBNewFileTransfer } { Segment name must be the same as the command name. }
-
- unit DummyUnit;
-
- interface
-
- uses MemTypes, QuickDraw, OSIntf, ToolIntf, CTBUtils, FTIntf, CMIntf, TMIntf, CRMIntf, HyperXCmd;
-
- procedure EntryPoint(paramPtr: XCmdPtr);
-
- implementation
-
- procedure CTBNewFileTransfer(paramPtr: XCmdPtr); forward;
-
- procedure EntryPoint(paramPtr: XCmdPtr);
-
- begin
- CTBNewFileTransfer(paramPtr);
- end;
-
- procedure CTBNewFileTransfer(paramPtr: XCmdPtr);
-
- {$I CTBUtil.inc}
-
- var i, j: integer;
- toolName: Str255;
- procID: integer;
- ftHand: FTHandle;
-
- procedure Fail(errMsg: Str255); { set theResult and quit }
- begin
- paramPtr^.returnValue := PasToZero(paramPtr,errMsg);
- exit(CTBNewFileTransfer);
- end;
-
- begin
- { Verify the number of parameters. }
- if paramPtr^.paramCount> 1 then Fail('Invalid parameter count');
-
- { Make sure the Comm Toolbox is present and ready. }
- CTBReady;
-
- { If there's already a file transfer tool open, close it. }
- if Globals^^.FTHand <> nil then
- begin
- { Dispose of the tool. }
- FTDispose(Globals^^.FTHand);
- { Remove it from the outstanding tool list. }
- j := 1;
- for i := 1 to Globals^^.allToolsSize do
- if Globals^^.allTools[i].ftHand <> Globals^^.FTHand then
- begin
- Globals^^.allTools[j] := Globals^^.allTools[i];
- j := j+1;
- end;
- Globals^^.allToolsSize := Globals^^.allToolsSize-1;
- SetHandleSize(Handle(Globals),sizeof(OurGlobalType)-sizeof(ToolArray)+
- Globals^^.allToolsSize*sizeof(OneToolType));
- Globals^^.FTHand := nil;
- end;
-
- { Find the proc ID. }
- if ParmPresent(1) then GetStrParm(1,toolName)
- else toolName := 'Text Tool';
- { Look up the ID. }
- procID := FTGetProcID(toolName);
- if procID = -1 then
- begin
- { If we couldn't get the one we wanted, then just get any one. }
- if CRMGetIndToolName(ClassFT,1,toolName) <> noErr then procID := -1
- else procID := FTGetProcID(toolName);
- { If there are no file transfer tools at all, fail. }
- if procID = -1 then Fail('Could not find a default tool');
- end;
-
- { Create the new connection handle. }
- ftHand := FTNew(procID,ftNoMenus+ftQuiet,nil,nil,nil,nil,nil,nil,0,0);
- if ftHand = nil then Fail('Could not create new file transfer record');
- { Save it. }
- Globals^^.FTHand := ftHand;
- { Add it to the outstanding tools list. }
- Globals^^.allToolsSize := Globals^^.allToolsSize+1;
- SetHandleSize(Handle(Globals),sizeof(OurGlobalType)-sizeof(ToolArray)+
- Globals^^.allToolsSize*sizeof(OneToolType));
- Globals^^.allTools[Globals^^.allToolsSize].tType := fileTransferTool;
- Globals^^.allTools[Globals^^.allToolsSize].ftHand := Globals^^.FTHand;
- end;
-
- end.
-